home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
ZMISC.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-06-25
|
19KB
|
756 lines
UNIT ZMisc;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Global ZModem routines Last changed: 25.06.96 SA ║}
{║ ║}
{║ (C) Copyright 1989-96 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
INTERFACE
USES Use32, OpDate;
CONST
ZPAD = 42; { '*'; }
ZDLE = 24;
ZDLEE = (ZDLE XOR 64);
ZBIN = 65; { 'A'; }
ZHEX = 66; { 'B'; }
ZBIN32 = 67; { 'C'; }
{--------------------------------------------------------------------}
{ Frame types }
{--------------------------------------------------------------------}
ZRQINIT = 0;
ZRINIT = 1;
ZSINIT = 2;
ZACK = 3;
ZFILE = 4;
ZSKIP = 5;
ZNAK = 6;
ZABORT = 7;
ZFIN = 8;
ZRPOS = 9;
ZDATA = 10;
ZEOF = 11;
ZFERR = 12;
ZCRC = 13;
ZCHALLENGE = 14;
ZCOMPL = 15;
ZCAN = 16;
ZFREECNT = 17;
ZCOMMAND = 18;
ZSTDERR = 19;
{--------------------------------------------------------------------}
{ ZDLE sequences }
{--------------------------------------------------------------------}
ZCRCE = 104; { 'h'; }
ZCRCG = 105; { 'i'; }
ZCRCQ = 106; { 'j'; }
ZCRCW = 107; { 'k'; }
ZRUB0 = 108; { 'l'; }
ZRUB1 = 109; { 'm'; }
{--------------------------------------------------------------------}
{ ZGetZDL return values }
{ -1 is general error, -2 is timeout }
{--------------------------------------------------------------------}
GOTOR = 256;
GOTCRCE = 360; { (ZCRCE or GOTOR) }
GOTCRCG = 361; { (ZCRCG or GOTOR) }
GOTCRCQ = 362; { (ZCRCQ or GOTOR) }
GOTCRCW = 363; { (ZCRCW or GOTOR) }
GOTCAN = 272; { (GOTOR or 24) }
{--------------------------------------------------------------------}
{ Byte positions within header array }
{--------------------------------------------------------------------}
ZF0 = 3;
ZF1 = 2;
ZF2 = 1;
ZF3 = 0;
ZP0 = 0;
ZP1 = 1;
ZP2 = 2;
ZP3 = 3;
{--------------------------------------------------------------------}
{ Bit Masks for ZRINIT flags byte ZF0 }
{--------------------------------------------------------------------}
CANFDX = 1;
CANOVIO = 2;
CANBRK = 4;
CANCRY = 8;
CANLZW = 16;
CANFC32 = 32;
{--------------------------------------------------------------------}
{ PARAMETERS FOR ZFILE FRAME... }
{--------------------------------------------------------------------}
{--------------------------------------------------------------------}
{ Conversion options on of these in ZF0 }
{--------------------------------------------------------------------}
ZCBIN = 1;
ZCNL = 2;
ZCRESUM = 3;
{--------------------------------------------------------------------}
{ Management options, one of these in ZF1 }
{--------------------------------------------------------------------}
ZMNEW = 1;
ZMCRC = 2;
ZMAPND = 3;
ZMCLOB = 4;
ZMSPARS = 5;
ZMDIFF = 6;
ZMPROT = 7;
{--------------------------------------------------------------------}
{ Transport options, one of these in ZF2 }
{--------------------------------------------------------------------}
ZTLZW = 1;
ZTCRYPT = 2;
ZTRLE = 3;
{--------------------------------------------------------------------}
{ Parameters for ZCOMMAND frame ZF0 (otherwise 0) }
{--------------------------------------------------------------------}
ZCACK1 = 1;
{--------------------------------------------------------------------}
{ Miscellaneous definitions }
{--------------------------------------------------------------------}
ok = 0;
Error = - 1;
TimeOut = - 2;
RCDO = - 3;
FUBAR = - 4;
XON = (Byte('Q') AND 31);
XOFF = (Byte('S') AND 31);
CPMEOF = (Byte('Z') AND 31);
RXBINARY = False;
RXASCII = False;
LZCONV = 0;
LZMANAG = 0;
LZTRANS = 0;
PATHLEN = 128;
KSIZE = 1024;
WAZOOMAX : Word = 8192;
{--------------------------------------------------------------------}
{ Parameters for calling ZModem routines }
{--------------------------------------------------------------------}
SPEC_COND = 2;
ZTRUE = 1;
ZFALSE = 0;
END_BATCH = - 1;
NOTHING_TO_DO = - 2;
DELETE_AFTER = '-';
SHOW_DELETE_AFTER = '^';
TRUNC_AFTER = '#';
NOTHING_AFTER = '@';
DO_WAZOO = ZTRUE;
DONT_WAZOO = ZFALSE;
TYPE
HeaderType = ARRAY[0..3] OF Byte;
BufAry = ARRAY[0..32768] OF Byte;
VAR
TxHdr, RxHdr : HeaderType;
RxTimeOut : LongInt;
RxType, RxFrameInd : Integer;
RxPos, Crc32 : LongInt;
FUNCTION ZGetByte(Tenths : Integer) : Integer;
PROCEDURE ZPutString(CONST s: String);
PROCEDURE ZPutLongIntoHeader(Position : LongInt; VAR TxHdr : HeaderType);
PROCEDURE ZSendHexHeader(HdrType : Integer; CONST Hdr : HeaderType);
PROCEDURE ZSendCan;
FUNCTION ZGetHeader(VAR Hdr : HeaderType) : Integer;
PROCEDURE ZUnCorkTransmitter;
FUNCTION ZGetZDL : Integer;
FUNCTION ZTimedRead : Integer;
IMPLEMENTATION
USES OpCrt, OpString, ApTimer,
Globals, Crc, Com, TransVid, Util, MTask, PoPTypes, LogFile;
PROCEDURE ZPutHex(HdrType : Integer);
VAR
s : String[2];
BEGIN
s:=StLoCase(Hexb(Byte(HdrType)));
ComPort^.WriteByte(Byte(s[1]), False);
ComPort^.WriteByte(Byte(s[2]), False);
END;
PROCEDURE ZUnCorkTransmitter;
VAR
t : EventTimer;
BEGIN
IF (NOT ComPort^.OutEmpty) AND ComPort^.Carrier THEN
BEGIN
NewTimer(t, Secs2Tics(5 * RxTimeOut) DIV 100);
REPEAT
{ GiveUpTime};
UNTIL (TimerExpired(t)) OR (ComPort^.OutEmpty) OR (NOT ComPort^.Carrier);
END;
ComPort^.SetXOn(Off);
ComPort^.SetXOn(On);
END;
PROCEDURE ZSendCan;
VAR
i : Byte;
BEGIN
ComPort^.PurgeOut; ComPort^.PurgeIn;
FOR i:=1 TO 10 DO
ComPort^.WriteByte(Can, False);
FOR i:=1 TO 10 DO
ComPort^.WriteByte(Bs, i=10);
END;
FUNCTION ZTimedRead : Integer;
VAR
c : Integer;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZTimedRead');
{$ENDIF}
REPEAT
c:=ZGetByte(RxTimeOut);
IF c<0 THEN Break;
c:=c AND $7f;
CASE c OF
XON,
XOFF : Continue;
Cr,
Lf,
ZDLE : Break;
ELSE IF (c AND $60)<>0 THEN Break ELSE Continue;
END;
UNTIL False;
{$IFDEF ZDebug}
AddLog('!','END ZTimedRead');
{$ENDIF}
ZTimedRead:=c;
END;
(* FUNCTION ZTimedRead : Integer;
VAR
c : Integer;
BEGIN
{$IFDEF ZDebug}
FastWrite('ZTimedRead ',1,1,7);
{$ENDIF}
WHILE True DO
BEGIN
c:=ZGetByte(RxTimeOut);
IF c < 0 THEN
BEGIN
ZTimedRead:=c;
Exit;
END;
CASE (c AND $7f) OF
XON,
XOFF : {continue} ;
Cr,
Lf,
ZDLE : BEGIN
ZTimedRead:=c;
Exit;
END;
ELSE {IF (c and $60) <> 0 THEN}
BEGIN
ZTimedRead:=c;
Exit;
END;
END;
END;
END;
*)
PROCEDURE ZPutLongIntoHeader(Position : LongInt; VAR TxHdr : HeaderType);
BEGIN
LongInt(TxHdr):=Position;
END;
FUNCTION ZPullLongFromHeader(CONST Hdr : HeaderType) : LongInt;
BEGIN
ZPullLongFromHeader:=LongInt(Hdr);
END;
FUNCTION ZGetZDL : Integer;
VAR
c : Integer;
BEGIN
c:=ZGetByte(RxTimeOut);
IF c<>ZDLE THEN
BEGIN
ZGetZDL:=c;
END ELSE
BEGIN
c:=ZGetByte(RxTimeOut);
CASE c OF
RCDO: ZGetZDL:=c; { DWK 16.12.92 }
Can : BEGIN
c:=ZGetByte(RxTimeOut);
IF c<0 THEN ZGetZDL:=c ELSE
IF c=CAN THEN
BEGIN
c:=ZGetByte(RxTimeOut);
IF c<0 THEN ZGetZDL:=c ELSE
IF c=Can THEN
BEGIN
c:=ZGetByte(RxTimeOut);
IF c<0 THEN ZGetZDL:=c ELSE ZGetZDL:=GOTCAN;
END;
END;
END;
ZCRCE,
ZCRCG,
ZCRCQ,
ZCRCW : ZGetZDL:=(c OR GOTOR);
ZRUB0 : ZGetZDL:=$7f;
ZRUB1 : ZGetZDL:=$ff;
ELSE BEGIN
IF c<0 THEN
ZGetZDL:=c
ELSE
IF ((c AND $60)=$40) THEN
ZGetZDL:=(c XOR $40)
ELSE
ZGetZDL:=Error;
END;
END;
END;
END;
FUNCTION ZGetHex: Integer;
VAR
c, n : Integer;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZGetHex');
{$ENDIF}
n:=ZTimedRead;
IF n<0 THEN
BEGIN
ZGetHex:=n;
Exit;
END;
Dec(n, 48);
IF n>9 THEN Dec(n,39);
IF (n AND $fff0)<>0 THEN
BEGIN
ZGetHex:=Error;
Exit;
END;
c:=ZTimedRead;
IF c<0 THEN
BEGIN
ZGetHex:=c;
Exit;
END;
Dec(c, 48);
IF c>9 THEN Dec(c, 39);
IF (c AND $fff0)<>0 THEN
BEGIN
ZGetHex:=Error;
Exit;
END;
ZGetHex:=((n SHL 4)+c);
END;
FUNCTION ZGetBinaryHeader(VAR Hdr: HeaderType): Integer;
VAR
c, n : Integer;
Crc16 : Word;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZGetBinaryHeader');
{$ENDIF}
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
ZGetBinaryHeader:=c;
Exit;
END;
RxType:=c;
Crc16:=UpdCrc16(c, 0);
FOR n:=0 TO 3 DO
BEGIN
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
ZGetBinaryHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(c, Crc16);
Hdr[n]:=c;
END;
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
ZGetBinaryHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(c, Crc16);
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
ZGetBinaryHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(c, Crc16);
IF Crc16<>0 THEN
BEGIN
ShowError('CRC error',True,false,false);
ZGetBinaryHeader:=Error;
Exit;
END;
ZGetBinaryHeader:=RxType;
END;
FUNCTION Z32GetBinaryHeader(VAR Hdr: HeaderType): Integer;
VAR
n : Byte;
c : Integer;
Crc32 : LongInt;
BEGIN
{$IFDEF ZDebug}
AddLog('!','Z32GetBinaryHeader');
{$ENDIF}
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
Z32GetBinaryHeader:=c;
Exit;
END;
RxType:=c;
Crc32:=$ffffffff;
Crc32:=UpdCrc32(c, Crc32);
FOR n:=0 TO 3 DO
BEGIN
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
Z32GetBinaryHeader:=c;
Exit;
END;
Crc32:=UpdCrc32(c, Crc32);
Hdr[n]:=c;
END;
FOR n:=0 TO 3 DO
BEGIN
c:=ZGetZDL;
IF Hi(c)<>0 THEN
BEGIN
Z32GetBinaryHeader:=c;
Exit;
END;
Crc32:=UpdCrc32(c, Crc32);
END;
IF Crc32<>$debb20e3 THEN
BEGIN
ShowError('CRC error',True,false,false);
Z32GetBinaryHeader:=Error;
Exit;
END;
Z32GetBinaryHeader:=RxType;
END;
FUNCTION ZGetHexHeader(VAR Hdr : HeaderType) : Integer;
VAR
c : Integer;
Crc16 : Word;
n : Byte;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZGetHexHeader');
{$ENDIF}
c:=ZGetHex;
IF Hi(c) <> 0 THEN
BEGIN
ZGetHexHeader:=c;
Exit;
END;
RxType:=c;
Crc16:=UpdCrc16(c, 0);
FOR n:=0 TO 3 DO
BEGIN
c:=ZGetHex;
IF Hi(c) <> 0 THEN
BEGIN
ZGetHexHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(Lo(c), Crc16);
Hdr[n]:=Lo(c);
END;
c:=ZGetHex;
IF Hi(c)<>0 THEN
BEGIN
ZGetHexHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(c, Crc16);
c:=ZGetHex;
IF Hi(c) <> 0 THEN
BEGIN
ZGetHexHeader:=c;
Exit;
END;
Crc16:=UpdCrc16(c, Crc16);
IF Crc16 <> 0 THEN
BEGIN
ShowError('CRC Error',True,false,false);
ZGetHexHeader:=Error;
Exit;
END;
IF ZGetByte(1)=Cr THEN ZGetByte(1);
ZGetHexHeader:=RxType;
END;
FUNCTION ZGetHeader(VAR Hdr : HeaderType) : Integer;
LABEL
Again, Agn2, EndCase2, EndCase3, GOTCAN, Done, Splat;
VAR
n : LongInt;
CanCount : ShortInt;
c : Integer;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZGetHeader');
{$ENDIF}
n:=ComPort^.GetBaudRate;
CanCount:=5;
Again:
{$IFDEF ZDebug}
AddLog('!','L11');
{$ENDIF}
IF GotESC THEN
BEGIN
ZSendCan;
ZGetHeader:=ZCAN;
Exit;
END;
RxFrameInd:=0; RxType:=0;
c:=ZTimedRead;
{$IFDEF BoDebug}
if c=error then AddLog('!','L1');
{$ENDIF}
CASE c OF
ZPAD,
(ZPAD OR 128) : ;
RCDO,
TimeOut : GOTO Done;
Can : BEGIN
GOTCAN:
{$IFDEF ZDebug}
AddLog('!','L12');
{$ENDIF}
Dec(CanCount);
IF CanCount <= 0 THEN
BEGIN
c:=ZCAN;
GOTO Done;
END;
c:=ZGetByte(1);
CASE c OF
TimeOut : GOTO Again;
ZCRCW : BEGIN
c:=Error;
GOTO Done;
END;
RCDO : GOTO Done;
Can : BEGIN
Dec(CanCount);
IF CanCount <= 0 THEN
BEGIN
c:=ZCAN;
GOTO Done;
END;
GOTO Again;
END;
END;
GOTO Agn2; { DWK 01.03.1993 }
END;
ELSE BEGIN
Agn2:
{$IFDEF ZDebug}
AddLog('!','L10');
{$ENDIF}
Dec(n);
IF n <= 0 THEN
BEGIN
ShowError('FUBAR',True,false,false);
ZGetHeader:=Error;
Exit;
END;
IF c <> Can THEN CanCount:=5;
GOTO Again;
END;
END; {Case}
{$IFDEF ZDebug}
AddLog('!','L05');
{$ENDIF}
CanCount:=5;
Splat:
{$IFDEF ZDebug}
AddLog('!','L06');
{$ENDIF}
c:=ZTimedRead;
{$IFDEF BoDebug}
if c=error then AddLog('!','L2');
{$ENDIF}
CASE c OF
ZDLE : {fallthrough} ;
ZPAD : GOTO Splat;
RCDO,
TimeOut : GOTO Done;
ELSE GOTO Agn2;
END;
EndCase2:
{$IFDEF ZDebug}
AddLog('!','L07');
{$ENDIF}
c:=ZTimedRead;
{$IFDEF BoDebug}
if c=error then AddLog('!','L3');
{$ENDIF}
CASE c OF
ZBIN : BEGIN
RxFrameInd:=ZBIN;
Crc32:=0;
c:=ZGetBinaryHeader(Hdr);
END;
ZBIN32 : BEGIN
Crc32:=ZBIN32;
RxFrameInd:=ZBIN32;
c:=Z32GetBinaryHeader(Hdr);
END;
ZHEX : BEGIN
RxFrameInd:=ZHEX;
Crc32:=0;
c:=ZGetHexHeader(Hdr);
END;
Can : GOTO GOTCAN;
RCDO,
TimeOut : GOTO Done;
ELSE GOTO Agn2;
END; {case}
EndCase3:
{$IFDEF ZDebug}
AddLog('!','L08');
{$ENDIF}
RxPos:=ZPullLongFromHeader(Hdr);
Done:
{$IFDEF ZDebug}
AddLog('!','L09');
{$ENDIF}
ZGetHeader:=c;
END; {ZGetHeader}
PROCEDURE ZSendHexHeader(HdrType: Integer; CONST Hdr: HeaderType);
VAR
Crc16 : Word;
n : Byte;
BEGIN
{$IFDEF ZDebug}
AddLog('!','ZSendHexHeader');
{$ENDIF}
ZUnCorkTransmitter;
ComPort^.WriteByte(ZPAD, False);
ComPort^.WriteByte(ZPAD, False);
ComPort^.WriteByte(ZDLE, False);
ComPort^.WriteByte(ZHEX, False);
ZPutHex(HdrType);
Crc16:=UpdCrc16(HdrType, 0);
FOR n:=0 TO 3 DO
BEGIN
ZPutHex(Hdr[n]);
Crc16:=UpdCrc16(Hdr[n], Crc16);
END;
Crc16:=UpdCrc16(0, Crc16);
Crc16:=UpdCrc16(0, Crc16);
ZPutHex(Hi(Crc16));
ZPutHex(Lo(Crc16));
IF (HdrType <> ZFIN) AND (HdrType <> ZACK) THEN ComPort^.WriteByte(17, False);
ComPort^.WriteByte(Cr, False);
ComPort^.WriteByte(Lf, True);
IF NOT ComPort^.Carrier THEN ComPort^.PurgeOut;
END;
PROCEDURE ZPutString(CONST s: String);
VAR
a : Byte;
BEGIN
FOR a:=1 TO Length(s) DO
CASE Byte(s[a]) OF
222 : Pause(200);
221 : {ZsendBreak} ;
ELSE ComPort^.WriteByte(Byte(s[a]), a=Length(s));
END;
ZUnCorkTransmitter;
END;
FUNCTION ZGetByte(Tenths: Integer) : Integer;
VAR
TOut : EventTimer;
BEGIN
{
IF NOT FCarrier THEN
BEGIN
ZGetByte:=RCDO;
Exit;
END;
}
IF ComPort^.Keypressed THEN
BEGIN
ZGetByte:=Integer(ComPort^.ReadByte);
END ELSE
BEGIN
NewTimer(TOut, Secs2Tics(Tenths*10) DIV 100);
REPEAT
IF NOT ComPort^.Carrier THEN
BEGIN
ZGetByte:=RCDO;
Exit;
END;
IF ComPort^.Keypressed THEN
BEGIN
ZGetByte:=Integer(ComPort^.ReadByte);
Exit;
END;
IF GotESC THEN
BEGIN
ZGetByte:=Error;
Exit;
END;
UNTIL TimerExpired(TOut);
ZGetByte:=TimeOut;
END;
END;
END.